home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EGAVGA.SWG / 0129_Text Font Routines.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-24  |  7KB  |  179 lines
  1.  
  2. UNIT video;
  3.  
  4. INTERFACE
  5.  
  6. USES DOS;
  7.  
  8. TYPE fontSize = (font8,font14,font16, unknownFontSize);
  9.      adapterType = (none,mda,cga,egaMono,egaColor,vgaMono,
  10.                    vgaColor,mcgaMono,mcgaColor);
  11.  
  12. VAR  textBufferOrigin  : pointer; {pointer to text buffer}
  13.      textBufferSeg     : word;
  14.      textBufferSize    : word;    {size in bytes of...}
  15.      visibleX,visibleY : byte;
  16.      fontLines         : byte;
  17.  
  18. function queryAdapterType : adapterType;
  19. function fontCode(h : byte) : fontSize; {convert from byte to enum}
  20. function getFontSize : fontSize; {normal 25 lines,ega 25 lines,vga 25 lines}
  21. function fontHeight(f : fontSize) : byte;
  22. procedure getTextBufferStats(var BX       : byte; {visible x dimentions}
  23.                              var BY       : byte; {visible y dimentions}
  24.                              var buffSize : word {refresh buffer size}
  25.                             );
  26. const maxX                : integer = 79;
  27.       maxY                : integer = 24;
  28.  
  29. IMPLEMENTATION
  30.  
  31. (******************************************************************************
  32. *                              queryAdapterType                              *
  33. ******************************************************************************)
  34. function queryAdapterType : adapterType;
  35.  
  36. var         regs : Registers;
  37.            code : byte;
  38.  
  39. begin
  40.         regs.ah := $1a; {vga identify}
  41.         regs.al := $0;  {clear}
  42.         intr($10,regs);
  43.         if regs.al = $1a then { is this a bug ???? }
  44.         begin {ps/2 bios search for ..}
  45.                 case regs.bl of {code back in here}
  46.                         $00 : queryAdapterType := none;
  47.                         $01 : queryAdapterType := mda;
  48.                         $02 : queryAdapterType := cga;
  49.                         $04 : queryAdapterType := egaColor;
  50.                         $05 : queryAdapterType := egaMono;
  51.                         $07 : queryAdapterType := vgaMono;
  52.                         $08 : queryAdapterType := vgaColor;
  53.                         $0A,$0C : queryAdapterType := mcgaColor;
  54.                         $0B : queryAdapterType := mcgaMono;
  55.                         else queryAdapterType := cga;
  56.                 end; {case}
  57.         end {ps/2 search}
  58.         else
  59.         begin {look for ega bios}
  60.                 regs.ah := $12;
  61.                 regs.bx := $10; {bl=$10 retrn ega info if ega}
  62.                 intr($10,regs);
  63.                 if regs.bx <> $10 then {bx unchanged mean no ega}
  64.                 begin
  65.                         regs.ah := $12; {ega call again}
  66.                         regs.bl := $10; {recheck}
  67.                         intr($10,regs);
  68.                         if (regs.bh = 0) then
  69.                                 queryAdapterType := egaColor
  70.                         else
  71.                                 queryAdapterType := egaMono;
  72.                 end {ega identification}
  73.         else {mda or cga}
  74.         begin
  75.                 intr($11,regs); {get eqpt.}
  76.                 code := (regs.al and $30) shr 4;
  77.                 case code of
  78.                         1,2 : queryAdapterType := cga;
  79.                         3   : queryAdapterType := mda;
  80.                         else queryAdapterType := none;
  81.                 end; {case}
  82.         end {mda, cga}
  83.         end;
  84. end; {quertAdapterType}
  85.  
  86. (******************************************************************************
  87. *                             getTextBufferStats                              *
  88. * return bx = #of columns, by = #of rows, buffSize = #of bytes in buffer      *
  89. ******************************************************************************)
  90. procedure getTextBufferStats;
  91. const screenLineMatrix : array[adapterType,fontSize] of integer =
  92.         ( (25,25,25, -1) {none adapter}, (-1,25,-1, -1) {mda},
  93.           (25,-1,-1, -1) {cga},(43,25,-1, -1) {egaMono}, (43,25,-1, -1) {egaColor},
  94.           (50,28,25, -1) {vgaMono}, (50,28,25, -1) {vgaColor},
  95.           (-1,-1,25, -1) {mcgaMono}, (-1,-1,25, -1) {mcgaColor} );
  96. {this matrix is saved in font8,font14,font16 sequence in rows of matrix}
  97. var
  98.         regs:registers;
  99. begin
  100.         regs.ah := $0f; {get current video mode}
  101.         intr($10,regs);
  102.         bx := regs.ah; {# of chars in a line, row}
  103.         by := screenLineMatrix[queryAdapterType, getFontSize];
  104.         if by > 0 then {legal height}
  105.                 buffSize := bx * 2 * by
  106.         else
  107.                 buffSize := 0;
  108. end; {getTextBufferStats}
  109.  
  110. (******************************************************************************
  111. *                                 getFontSize                                 *
  112. ******************************************************************************)
  113. function getFontSize : fontSize;
  114. var
  115.         regs  : registers;
  116.    fs    : fontSize;
  117.    at    : adapterType;
  118. begin
  119.    at := queryAdapterType;
  120.         case at of
  121.                 cga                 : fs := font8;
  122.                 mda                 : fs := font14;
  123.                 mcgaMono,
  124.                 mcgaColor        : fs:= font16;
  125.                 egaMono,
  126.                 egaColor,
  127.                 vgaMono,
  128.                 vgaColor        : begin
  129.                                         with regs do begin
  130.                (* check this interrupt call, there might be some bug,
  131.                   either in the call conventions, or in the 3300A
  132.                   bios. *)
  133.                                                 ah := $11; {egavga call}
  134.                                                 al := $30;
  135. (*                                                bl := $0;   *)
  136.                                                 bh := $0;
  137.                                         end; {with}
  138.                                         intr($10,regs);
  139.                                         fs := fontCode(regs.cl);
  140.                if (fs = unknownFontSize) then
  141.                   fs := font16; { assume a work around in 330A screen}
  142.                                 end; {ega vga}
  143.         end; {case}
  144.    getFontSize := fs;
  145. end; {getFontSize}
  146.  
  147. (******************************************************************************
  148. *                                  fontCode                                   *
  149. * Convert from byte size to a fontSize type                                                                                 *
  150. ******************************************************************************)
  151. function fontCode;
  152. begin
  153.         case h of
  154.                  8 : fontCode := font8;
  155.                 14 : fontCode := font14;
  156.                 16 : fontCode := font16;
  157.       else fontCode := unknownFontSize; { unKnown, assume 8 }
  158.         end; {case}
  159. end; {fontCode}
  160.  
  161. (******************************************************************************
  162. *                                 fontHeight                                 *
  163. ******************************************************************************)
  164. function fontHeight(f : fontSize) : byte;
  165. begin
  166.         case f of
  167.                 font8  : fontHeight := 8;
  168.                 font14 : fontHeight := 14;
  169.                 font16 : fontHeight := 16;
  170.         end; {case}
  171. end; {fontHeight}
  172.  
  173. begin
  174.    getTextBufferStats(visibleX, visibleY, textBufferSize);
  175.    maxX := visibleX - 1;
  176.    maxY := visibleY - 1;
  177.    fontLines := fontHeight(getFontSize);
  178. end.
  179.